@rem = '--*-Perl-*-- vim: set ft=perl:
@echo off
D:\usr\local\perl\bin\perl.exe -x -S "%~dpnx0" %*
if errorlevel 1 pause
goto endofperl
@rem ';
#!/usr/bin/perl
#line 9

# Referenced from:
# http://www.perlmonks.org/?node=Clipboard%20transform%20keys

use strict;
use warnings;
use File::Copy;
use File::Glob qw(:globally :nocase);
use Getopt::Long qw(:config gnu_getopt);
use Win32::Clipboard;

use constant INTRO_TXT => 'intro.txt';
use constant IMAGE_EXTS => qw(JPG JPEG PNG GIF BMP);
use constant IMAGE_PATH => 'D:/zerox/picture/movie';
use constant POSTER_FORMAT => 'poster%s%s';

sub move_file($$)
{
	my ($from, $to) = @_;

	if (!move($from, $to)) {
		print STDERR "ERROR: move fail: $!\n";
		return 0;
	}
	return 1;
}

sub get_clipboard_text()
{
	my $t;

	if (!Win32::Clipboard::IsText()) {
		print STDERR "warning: clipboard has no text\n";
	}
	$t = Win32::Clipboard::GetText();
	if (!defined($t)) {
		return '';
	}
	return $t;
}

sub strip_text($)
{
	my ($text) = @_;

	# Why should we need this?
	$text =~ tr/\r//d;

	# Leading blanks (including new lines) are just stripped off
	$text =~ s/^\s+//;
	# Trailing blanks are also removed, or add new line if there is none
	$text =~ s/\s*$/\n/;

	# Consecutive blank lines are squeezed into one
	$text =~ s/^\s+$//gm;
	# Trailing blanks in every line are removed
	$text =~ s/[\t ]+$//gm;

	return $text;
}

=item
sub print_text($)
{
	my ($text) = @_;

	$text =~ s/ /*/g;
	$text =~ s/\r/\\r/g;
	$text =~ s/$/\|/gm;
	print STDERR "Text (with spaces replaced with DOT):\n", $text, "\n";
}
=cut

my %options = (
	'help'      => +{ 'option' => 'help|h',        'value' => 0  },
	'directory' => +{ 'option' => 'd|directory=s', 'value' => '' }
);

sub do_it {
	my $t = get_clipboard_text();

	$t = strip_text($t);
	if ($t eq '') {
		return 0;
	}

	my $rel_name;
	if ($t =~ m/^([[:alnum:]\']+(?:\.[[:alnum:]\']+)+-[[:alnum:]]+)/) {
		$rel_name = $1;
	} elsif ($t =~ m/^.*?([[:alnum:]\']+(?:[\._-][[:alnum:]\']+){2,}-[[:alnum:]]+)/) {
		$rel_name = $1;
	}
	if (!defined($rel_name)) {
		# Try harder to find the release name
		if ($t =~ m/^([[:alnum:]\']+(?:[ ][[:alnum:]\']+)+-[[:alnum:]]+)/) {
			($rel_name = $1) =~ s/[ ]/./g;
		} elsif ($t =~ m/^.*?([[:alnum:]\']+(?:[ ][[:alnum:]\']+){2,}-[[:alnum:]]+)/) {
			($rel_name = $1) =~ s/[ ]/./g;
		}
	}
	if (defined($rel_name)) {
		print STDERR "Release name: $rel_name\n";
	} else {
		print STDERR "Unknown release name\n";
	}

	my $out_dir = $ARGV[0] || $rel_name || '.';
	if ($out_dir eq ".") {
		print STDERR "Using current directory for output\n";
	} else {
		mkdir $out_dir or die $!;
		chdir $out_dir or die $!;
		print STDERR "Created dir: $out_dir\n";
	}

	open OUT, ">", INTRO_TXT() or die $!;
	print OUT $t;
	close OUT;
	printf STDERR "Saved %s\n", INTRO_TXT();

	my $glob_pat = sprintf "%s/*.{%s}", IMAGE_PATH(), join(",", IMAGE_EXTS());
	print STDERR "glob pattern: $glob_pat\n";
	my @image_files = glob($glob_pat);
	for (my $i = 0; $i < @image_files; ++$i) {
		my $ext = $image_files[$i] =~ m/(\.\w+)$/;
		$ext = $ext ? lc($1) : '';
		my $seq_str = $i == 0 ? '' : sprintf "%d", $i;
		my $target_name = sprintf(POSTER_FORMAT, $seq_str, $ext);
		printf STDERR "Moving: %s (ext %s) --> '%s': ",
			$image_files[$i], $ext, $target_name;
		if (move_file($image_files[$i], $target_name)) {
			print STDERR "success\n";
		} else {
			print STDERR "FAILED\n";
		}
	}
	print STDERR "Done\n";
}

do_it();
exit 0;

__END__
:endofperl
